library(dplyr)
library(knitr)
library(maptools)
library(rgdal)
library(TreeSegmentation)
library(sp)
library(ggplot2)
library(rgl)
library(clue)
library(lidR)
knit_hooks$set(webgl = hook_webgl)
opts_chunk$set(warning=F,message=F)
#set color ramp for treeID
col = pastel.colors(200)
#set data paths
path_to_tiles="../data/2017/Lidar/"
#set cores
cores<-4
#cores<-15
shps<-list.files("../data/ITCs/test/",pattern=".shp",full.names = T)
itcs<-lapply(shps,readOGR,verbose=F)
names(itcs)<-sapply(itcs,function(x){
id<-unique(x$Plot_ID)
return(id)
})
ground_truth<-itcs[[1]]
fname<-get_tile_filname(ground_truth)
tile<-readLAS(paste("../data/2017/Lidar/",fname,sep=""))
tile@crs<-CRS("+init=epsg:32617")
plot(tile)
You must enable Javascript to view this page properly.
plot(extent(tile),col='red')
plot(extent(ground_truth),col='blue',add=T)
silva<-silva2016(tile=tile,output="all")
## [1] "Computing Ground Model"
## [1] "Computing Canopy Model"
## [1] "Clustering Trees"
## user system elapsed
## 3.963 0.059 4.070
## [1] "Creating tree polygons"
dalponte<-dalponte2016(tile=tile,output="all")
## [1] "Computing Ground Model"
## [1] "Computing Canopy Model"
## [1] "Clustering Trees"
## user system elapsed
## 3.504 0.062 3.690
## [1] "Creating tree polygons"
li<-li2012(tile=tile,output="all")
## [1] "Computing Ground Model"
## [1] "Computing Canopy Model"
## [1] "Clustering Trees"
## user system elapsed
## 0.086 0.001 0.089
## [1] "Creating tree polygons"
watershed_result<-watershed(tile=tile,output="all")
## [1] "Computing Ground Model"
## [1] "Computing Canopy Model"
## [1] "Clustering Trees"
## user system elapsed
## 5.602 0.091 5.803
## [1] "Creating tree polygons"
plot(silva$tile,color="treeID",col=col)
You must enable Javascript to view this page properly.
plot(silva$convex)
plot(ground_truth,col='red')
plot(silva$convex,add=T)
#plot(dalponte$convex,add=T)
chm=canopy_model(silva$tile)
plot(chm,ext=extent(ground_truth))
plot(ground_truth,add=T,col='red')
plot(silva$convex,add=T)
Okay that’s not great, but let’s keep going for the moment.
Silva v Dalponte
plot(chm,ext=extent(ground_truth))
plot(silva$convex,add=T)
plot(dalponte$convex,add=T,col=rgb(0,0,255,20,maxColorValue=255))
Li versus watershed
plot(chm,ext=extent(ground_truth))
plot(li$convex)
plot(watershed_result$convex,add=T,col=rgb(0,0,255,20,maxColorValue=255))
for(i in 1:length(ground_truth)){
plot(ground_truth[i,])
plotclip<-lasclip(x=silva$tile,geometry = ground_truth[i,])
points(cbind(plotclip@data$X,plotclip@data$Y),col=plotclip@data$X)
}
ptlist<-list(dalponte=dalponte$tile,silva=silva$tile,li=li$tile,watershed=watershed_result$tile)
system.time(consensus_result<-consensus(ptlist=ptlist,method="majority"))
## user system elapsed
## 4.064 0.150 4.279
consensus_polygons<-get_convex_hulls(consensus_result,consensus_result@data$treeID)
plot(consensus_polygons,col=rgb(0,0,255,20,maxColorValue=255))
paste(length(consensus_polygons),"consensus clusters found")
## [1] "117 consensus clusters found"
#plot(consensus_result,color="treeID",col=col)
You must enable Javascript to view this page properly.
plot(silva$convex)
plot(dalponte$convex)
plot(li$convex)
plot(consensus_polygons,add=T,col=rgb(0,0,255,40,maxColorValue=255))
How many tree predictions?
library(pander)
unique_total<-sapply(c(ptlist,consensus_result),function(x) length(unique(x@data$treeID)))
df<-data.frame(Algorthm=c(names(ptlist),"consensus"),Total_Trees=as.numeric(unique_total))
pandoc.table(df,style="rmarkdown")
##
##
## | Algorthm | Total_Trees |
## |:---------:|:-----------:|
## | dalponte | 118 |
## | silva | 117 |
## | li | 276 |
## | watershed | 63 |
## | consensus | 118 |
Each tree is assigned based on the maximum overlap. Pairwise membership is done using a Hungarian Algorithm. See clue::solve_LSAP.
assignment<-assign_trees(ground_truth,prediction=silva$convex)
#loop through assignments and get jaccard statistic for each assignment pair
statdf<-calc_jaccard(assignment=assignment,ground_truth = ground_truth,prediction=silva$convex)
ggplot(statdf) + geom_histogram(aes(IoU)) + labs(x="Intersection over union") + theme_bw()
mean(statdf$IoU)
## [1] 0.3452619
median(statdf$IoU)
## [1] 0.3580353
results<-evaluate(ground_truth=itcs[[9]],algorithm = c("silva","dalponte"),path_to_tiles=path_to_tiles,compute_consensus = F,plot_results=T)
## [1] "Silva"
## [1] "Computing Ground Model"
## [1] "Computing Canopy Model"
## [1] "Clustering Trees"
## user system elapsed
## 7.216 0.125 8.171
## [1] "Creating tree polygons"
## [1] "Dalponte"
## [1] "Computing Ground Model"
## [1] "Computing Canopy Model"
## [1] "Clustering Trees"
## user system elapsed
## 6.738 0.091 6.915
## [1] "Creating tree polygons"
ggplot(results,aes(y=IoU,x=Method)) + geom_boxplot() + theme_bw()
results %>% group_by(Method) %>% summarize(mean=mean(IoU),median=median(IoU))
## # A tibble: 2 x 3
## Method mean median
## <chr> <dbl> <dbl>
## 1 dalponte 0.288 0.328
## 2 silva 0.253 0.224
system.time(results_all<-evaluate_all(itcs=itcs,algorithm = c("dalponte","li","watershed","silva"),path_to_tiles=path_to_tiles,cores=cores,extra=F,compute_consensus=F,plot_results = T))
## [1] "ITC has no overlap with cropped tile"
## user system elapsed
## 0.210 0.049 1149.238
#plot results
ggplot(results_all,aes(y=IoU,x=Method)) + geom_boxplot() + theme_bw()
#Compute test statistics
test_statistic<-results_all %>% group_by(Method) %>% summarize(mean=mean(IoU),median=median(IoU)) %>% mutate(Date=format(Sys.time(), "%m/%d/%y %H:%M:%S"))
test_statistic
## # A tibble: 4 x 4
## Method mean median Date
## <chr> <dbl> <dbl> <chr>
## 1 dalponte 0.255 0.249 05/03/18 09:33:27
## 2 li 0.269 0.255 05/03/18 09:33:27
## 3 silva 0.257 0.242 05/03/18 09:33:27
## 4 watershed 0.211 0.204 05/03/18 09:33:27
write.table(test_statistic,"Results/results.csv",append = T,col.names = F,sep=",",row.names = F)